home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / T-TPUG Old Monthly Disks / (c)t2.d64 / pegsol.d (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  7KB  |  222 lines
  1. 1 REM - PEG SOLITAIRE FOR COMMODORE 64
  2. 2 REM - DANIEL MILLER
  3. 3 REM - 2815 34 STREET
  4. 4 REM - ASTORIA, QUEENS
  5. 5 REM - NEW YORK, NEW YORK   11103
  6. 6 REM - 03/06/83
  7. 7 REM *********************************
  8. 10 DIM A$(3),B(37),C$(15),C(37),D$(15)
  9. 20 PRINTCHR$(147):GOTO10000
  10. 40 POKEVO,15:POKEWV,17:POKEAT,15:POKEHI,68:POKELO,149
  11. 50 FOR TM=1 TO 100:NEXT TM:POKEWV,0
  12. 55 POKEVO,15:POKEWV,17:POKEAT,15
  13. 60 POKEWV,17:POKEHI,34:POKELO,75
  14. 75 FOR TM=1 TO 100:NEXT TM:POKEWV,0:RETURN
  15. 150 FOR X=1 TO 37:B(X)=2:NEXT:B(19)=1
  16. 160 AA=1:GOSUB230:AA=0
  17. 200 PRINTTAB(14)DW$;RV$;"PEG SOLITAIRE";RO$;:FOR TM=1 TO 2500:NEXT TM
  18. 215 GOSUB1000
  19. 220 REM - PUZZLE SCREEN
  20. 230 PRINT CHR$(19);
  21. 400 PRINTLEFT$(DO$,4)TAB(15)A$(B(1));U$TAB(20)A$(B(2));U$TAB(25)A$(B(3)):PRINT
  22. 405 IF VAL(F2$)<>1 THEN410
  23. 406 GOSUB40
  24. 410 PRINTTAB(10)A$(B(4));U$TAB(15)A$(B(5));U$TAB(20)A$(B(6));U$TAB(25)A$(B(7));
  25. 415 PRINTU$TAB(30)A$(B(8)):PRINT
  26. 416 IF VAL(F2$)<>2 THEN420
  27. 417 GOSUB40
  28. 420 PRINTTAB(5)A$(B(9));U$TAB(10)A$(B(10));U$TAB(15)A$(B(11));
  29. 421 PRINTU$TAB(20)A$(B(12));
  30. 425 PRINTU$TAB(25)A$(B(13));U$TAB(30)A$(B(14));U$TAB(35)A$(B(15)):PRINT
  31. 426 IF VAL(F2$)<>3 THEN430
  32. 427 GOSUB40
  33. 430 PRINTTAB(5)A$(B(16));U$TAB(10)A$(B(17));U$TAB(15)A$(B(18));
  34. 431 PRINTU$TAB(20)A$(B(19));U$TAB(25)A$(B(20));U$TAB(30)A$(B(21));
  35. 432 PRINTU$TAB(35)A$(B(22)):PRINT
  36. 435 IF VAL(F2$)<>4 THEN440
  37. 436 GOSUB40
  38. 440 PRINTTAB(5)A$(B(23));U$TAB(10)A$(B(24));U$TAB(15)A$(B(25));
  39. 441 PRINTU$TAB(20)A$(B(26));U$TAB(25)A$(B(27));U$TAB(30)A$(B(28));
  40. 442 PRINTU$TAB(35)A$(B(29)):PRINT
  41. 445 IF VAL(F2$)<>5 THEN450
  42. 446 GOSUB40
  43. 450 PRINTTAB(10)A$(B(30));U$TAB(15)A$(B(31));U$TAB(20)A$(B(32));
  44. 451 PRINTU$TAB(25)A$(B(33));U$TAB(30)A$(B(34)):PRINT
  45. 455 IF VAL(F2$)<>6 THEN460
  46. 456 GOSUB40
  47. 460 PRINTTAB(15)A$(B(35));U$TAB(20)A$(B(36));U$TAB(25)A$(B(37))
  48. 465 IF VAL(F2$)<>7 THEN500
  49. 466 GOSUB40
  50. 500 D=99:E=120:FOR X=1202 TO 1992 STEPE:POKEX,D:NEXT
  51. 510 FOR X=1207 TO 1997 STEPE:POKEX,D:NEXT
  52. 520 FOR X=1317 TO 1797 STEPE:POKEX,D:NEXT
  53. 530 FOR X=1332 TO 1812 STEPE:POKEX,D:NEXT
  54. 540 FOR X=1432 TO 1672 STEPE:POKEX,D:NEXT
  55. 545 FOR X=1457 TO 1697 STEPE:POKEX,D:NEXT
  56. 548 IF AA=1 THEN RETURN
  57. 550 FOR X=55342 TO 55372 STEP5:POKEX,10:NEXT
  58. 555 X=49:FOR Y=1070 TO 1100 STEP5:POKEY,X:X=X+1:NEXT
  59. 560 FOR X=55418 TO 56218 STEPE:POKEX,10:NEXT
  60. 565 X=49:FOR Y=1146 TO 1946 STEPE:POKEY,X:X=X+1:NEXT
  61. 570 S1$=RV$+CHR$(159)+"MOVE #"+RO$:PRINTLEFT$(DO$,22);TAB(30) S1$;
  62. 600 S1$=RV$+CHR$(159)+"FROM"+RO$:S2$=RV$+CHR$(159)+"TO"+RO$
  63. 605 PRINT DO$;TAB(10) S1$;TAB(24) S2$;
  64. 610 PRINT DOWN$;TAB(15);"   ";DOWN$;TAB(15);"";
  65. 611 GET F$:IF F$="" THEN611
  66. 612 F0=ASC(F$):IF F0=133 OR F0=134 OR F0=135 OR F0=136 THEN740
  67. 616 GET G$:IF G$="" THEN616
  68. 617 FR$=F$+G$:PRINT FR$;:F$="":G$=""
  69. 618 IF LEFT$(FR$,1)<"1" OR LEFT$(FR$,1)>"9" THEN FR$="":GOTO610
  70. 619 IF RIGHT$(FR$,1)<"1" OR RIGHT$(FR$,1)>"9" THEN FR$="":GOTO610
  71. 620 H=VAL(FR$):F1=H:GOSUB8000:FR=H:C(FR)=VAL(MID$(D$,FR,1))
  72. 660 PRINT DOWN$;TAB(27);"   ";DOWN$;TAB(27);"";
  73. 665 GET F$:IF F$="" THEN665
  74. 666 GET G$:IF G$="" THEN666
  75. 667 TU$=F$+G$:PRINT TU$;:F$="":G$=""
  76. 668 IF LEFT$(TU$,1)<"1" OR LEFT$(TU$,1)>"7" THEN TU$="":GOTO660
  77. 669 IF RIGHT$(TU$,1)<"1" OR RIGHT$(TU$,1)>"7" THEN TU$="":GOTO660
  78. 670 H=VAL(TU$):T1=H:GOSUB8000:TU=H:C(TU)=VAL(MID$(D$,TU,1))
  79. 675 F2$=LEFT$(FR$,1)
  80. 680 FR$=MID$(D$,FR,1):TU$=MID$(D$,TU,1)
  81. 690 IF FR$="1" THEN ER=1:GOTO900
  82. 691 IF TU$="2" THEN ER=2:GOTO900
  83. 692 IF FR$="3" OR TU$="3" THEN ER=3:GOTO900
  84. 700 C=C(TU):C(TU)=C(FR):C(FR)=C
  85. 705 IF F1-T1=2 OR F1-T1=-2 OR F1-T1=20 OR F1-T1=-20 THEN800
  86. 710 D$="":FOR X=1 TO 37:D$=D$+RIGHT$(STR$(C(X)),1):NEXT
  87. 720 PRINT DOWN$;TAB(15);"   ";:PRINT DOWN$;TAB(27);"   ";
  88. 730 FOR X=1 TO 37:B(X)=VAL(MID$(D$,X,1)):NEXT:GOTO220
  89. 740 F0=0:MV=MV+1:PRINT LEFT$(DOWN$,22);TAB(37);STR$(MV);:GOTO220
  90. 800 IF ABS(F1-T1)=20 THEN J=1:GOTO820
  91. 805 J=2:GOTO830
  92. 820 IF F1>T1 THEN825
  93. 821 H=F1+10:GOTO826
  94. 825 H=F1-10
  95. 826 GOSUB8000:C(H)=1:GOTO710
  96. 830 IF F1>T1 THEN835
  97. 831 H=F1+1:GOTO836
  98. 835 H=F1-1
  99. 836 GOSUB8000:C(H)=1:GOTO710
  100. 900 ON ER GOTO 910,920,930
  101. 910 ER$=RV$+"'FROM' POSITION EMPTY"+RO$:GOSUB950:F2$="":GOTO220
  102. 920 ER$=RV$+"'TO' POSITION OCCUPIED"+RO$:GOSUB950:F2$="":GOTO220
  103. 930 ER$=RV$+"INVALID MOVE"+RO$:GOSUB950:F2$="":GOTO220
  104. 950 PRINT DOWN$;TAB(5);"                        ";
  105. 951 FOR X=1 TO 5
  106. 952 PRINT DOWN$;TAB(22-(LEN(ER$)/2));ER$;:FOR TM=1 TO 500:NEXT TM
  107. 954 PRINT DOWN$;"                                 ";
  108. 956 FOR TM=1 TO 500:NEXT TM:NEXT X:RETURN
  109. 999 REM - MAIN MENU
  110. 1000 S1$=DW$+RV$+CHR$(159)+"PEG SOLITAIRE"+RO$
  111. 1010 PRINTCL$:PRINTTAB(14)S1$;DW$
  112. 1200 FOR X=1 TO 15:PRINTTAB(5)STR$(X)". ";C$(X):NEXT
  113. 1270 RESTORE:FOR X=1 TO 15:READ C$:NEXT
  114. 1300 PRINT DW$;TAB(10)"SELECT CHOICE ";:INPUT PZ
  115. 1305 IF PZ=15 THEN PRINTCL$:END
  116. 1310 ON PZ GOSUB11000,11100,11200,11300,11400,11500,11600,11700,11800,11900
  117. 1312 IF PZ<11 THEN1320
  118. 1315 ON PZ-10 GOSUB12000,12100,12200,12300
  119. 1320 RESTORE:FOR X=1 TO PZ:READ C$:NEXT
  120. 1330 RESTORE:FOR X=1 TO 15:READ X$:NEXT
  121. 1340 FOR X=1 TO PZ:READ PP$,JJ$,CC$:NEXT
  122. 1350 GOSUB7000
  123. 1400 D$=D$(PZ):FOR X=1 TO 37:B(X)=VAL(MID$(D$,X,1)):C(X)=B(X):NEXT:F2$=""
  124. 1450 POKE53280,8:POKE53281,6:MV=0:PRINTCL$:GOTO230
  125. 7000 PRINTCL$:S1$=DW$+RV$+C$+RO$+DW$:PRINTTAB(20-(LEN(C$)/2));S1$
  126. 7100 PRINT" IN ORDER TO SOLVE THIS PUZZLE, REMOVE"
  127. 7110 S1$=RV$+PP$+RO$:S2$=RV$+JJ$+RO$
  128. 7115 PRINT" "S1$;" PIECES IN ";S2$;" MOVES LEAVING THE LAST"
  129. 7120 S1$=RV$+CC$+RO$:PRINT" PLAYING PIECE IN POSITION ";S1$;"."
  130. 7200 PRINTLEFT$(DOWN$,20);TAB(8)"PRESS <RETURN> TO CONTINUE"
  131. 7210 GET RR$:IF RR$="" THEN7210
  132. 7220 IF RR$<>CHR$(13) THEN7210
  133. 7230 RETURN
  134. 8000 IF H=13 THEN H=1:RETURN
  135. 8010 IF H=14 THEN H=2:RETURN
  136. 8020 IF H=15 THEN H=3:RETURN
  137. 8030 IF H=22 THEN H=4:RETURN
  138. 8040 IF H=23 THEN H=5:RETURN
  139. 8050 IF H=24 THEN H=6:RETURN
  140. 8060 IF H=25 THEN H=7:RETURN
  141. 8070 IF H=26 THEN H=8:RETURN
  142. 8080 IF H=31 THEN H=9:RETURN
  143. 8090 IF H=32 THEN H=10:RETURN
  144. 8100 IF H=33 THEN H=11:RETURN
  145. 8110 IF H=34 THEN H=12:RETURN
  146. 8120 IF H=35 THEN H=13:RETURN
  147. 8130 IF H=36 THEN H=14:RETURN
  148. 8150 IF H=37 THEN H=15:RETURN
  149. 8160 IF H=41 THEN H=16:RETURN
  150. 8170 IF H=42 THEN H=17:RETURN
  151. 8180 IF H=43 THEN H=18:RETURN
  152. 8190 IF H=44 THEN H=19:RETURN
  153. 8200 IF H=45 THEN H=20:RETURN
  154. 8210 IF H=46 THEN H=21:RETURN
  155. 8220 IF H=47 THEN H=22:RETURN
  156. 8230 IF H=51 THEN H=23:RETURN
  157. 8240 IF H=52 THEN H=24:RETURN
  158. 8250 IF H=53 THEN H=25:RETURN
  159. 8260 IF H=54 THEN H=26:RETURN
  160. 8270 IF H=55 THEN H=27:RETURN
  161. 8280 IF H=56 THEN H=28:RETURN
  162. 8290 IF H=57 THEN H=29:RETURN
  163. 8300 IF H=62 THEN H=30:RETURN
  164. 8310 IF H=63 THEN H=31:RETURN
  165. 8320 IF H=64 THEN H=32:RETURN
  166. 8330 IF H=65 THEN H=33:RETURN
  167. 8340 IF H=66 THEN H=34:RETURN
  168. 8350 IF H=73 THEN H=35:RETURN
  169. 8360 IF H=74 THEN H=36:RETURN
  170. 8370 IF H=75 THEN H=37:RETURN
  171. 8380 IF H=99 THEN8500
  172. 8400 FOR X=1 TO 5
  173. 8410 S1$=RV$+"INCORRECT FROM/TO POSITION"+RO$
  174. 8415 PRINTDO$;TAB(9)S1$;:FOR TM=1 TO 500:NEXT TM
  175. 8420 PRINT DOWN$;TAB(9);"                          ";:FOR TM=1 TO 500:NEXT TM
  176. 8430 NEXT X:F2$="":GOTO220
  177. 8500 S1$="I HOPE YOU HAD FUN WITH "+RV$+"'PEG SOLITAIRE'"+RO$
  178. 8510 PRINT DOWN$;S1$;:FOR TM=1 TO 1500:NEXT TM:PRINTCL$:GOTO1000
  179. 9900 DATA LATIN CROSS,GREEK CROSS,FOOTBALL TEAM,PYRAMID OF CHEFREN,SHRINE
  180. 9910 DATA PYRAMID OF CHEOPS,TIFFANY LAMP,CENTER TO CENTER,DAVIS JUMP
  181. 9920 DATA FIVE CROSSES,PENTAGON,DOUBLE CROSS,TILTED SQUARE,OCTAGRAM
  182. 9930 DATA END PROGRAM
  183. 9940 DATA 5,5,44,8,6,44,10,8,44,8,8,44,14,12,43,15,12,44,16,10,44,31,18,44
  184. 9950 DATA 31,15,35,20,10,44,23,15,44,20,16,44,23,11,44,28,24,44
  185. 10000 DW$=CHR$(17):U$=CHR$(145):RV$=CHR$(18):RO$=CHR$(146):BL$=CHR$(144)
  186. 10002 WH$=CHR$(5):GR$=CHR$(30):LF$=CHR$(157)+CHR$(157):CL$=CHR$(147)
  187. 10005 A$(1)=RV$+BL$+CHR$(117)+CHR$(105)+DW$+LF$+CHR$(106)+CHR$(107)+RO$
  188. 10008 A$(2)=RV$+WH$+CHR$(117)+CHR$(105)+DW$+LF$+CHR$(106)+CHR$(107)+RO$
  189. 10010 A$(3)=RV$+GR$+CHR$(176)+CHR$(174)+DW$+LF$+CHR$(173)+CHR$(189)+RO$
  190. 10020 FOR X=1 TO 15:READ C$(X):NEXT
  191. 10030 FOR X=1 TO 24:DO$=DW$+DO$:NEXT X:DO$=CHR$(19)+DO$
  192. 10050 VO=54296:WV=54276:AT=54277:HI=54273:LO=54272:F2=0:F2$=""
  193. 10100 GOTO150
  194. 10999 REM - LATIN CROSS
  195. 11000 D$(1)="1111121111222111112111111211111111111":RETURN
  196. 11099 REM - GREEK CROSS
  197. 11100 D$(2)="1111121111121111222221111211111211111":RETURN
  198. 11199 REM - FOOTBALL TEAM
  199. 11200 D$(3)="2221222111222111121211111111111111111":RETURN
  200. 11299 REM - PYRAMID OF CHEFREN
  201. 11300 D$(4)="1113111311121111122211122222131113111":RETURN
  202. 11399 REM - THE SHRINE
  203. 11400 D$(5)="1211121112222211112111111211112221222":RETURN
  204. 11499 REM - PYRAMID OF CHEOPS
  205. 11500 D$(6)="1111121111222111222221222222211111111":RETURN
  206. 11599 REM - TIFFANY LAMP
  207. 11600 D$(7)="1213222312222211112111111211132223222":RETURN
  208. 11699 REM - CENTER TO CENTER
  209. 11700 D$(8)="2223222322222222221222222222232223222":RETURN
  210. 11799 REM - DAVIS JUMP
  211. 11800 D$(9)="2223222322221222222222222222232223222":RETURN
  212. 11899 REM - FIVE CROSSES
  213. 11900 D$(10)="1211222112121212222222121212112221121":RETURN
  214. 11999 REM - PENTAGON
  215. 12000 D$(11)="1213222312222212222222122222132223111":RETURN
  216. 12099 REM - DOUBLE CROSS
  217. 12100 D$(12)="1212121211222112222222112221121212121":RETURN
  218. 12199 REM - TILTED SQUARE
  219. 12200 D$(13)="1211222112222212221222122222112221121":RETURN
  220. 12299 REM - OCTAGRAM
  221. 12300 D$(14)="1212222212222212222222122222122222121":RETURN
  222.